home *** CD-ROM | disk | FTP | other *** search
/ Macwelt 1 / Macwelt DVD 1.toast / Web-Publishing / HTML-Editoren / Alpha ƒ / Tcl / Modes / browserMode.tcl < prev    next >
Encoding:
Text File  |  2000-12-05  |  11.2 KB  |  375 lines
  1. #=============================================================================
  2. # Browser mode.
  3. # 
  4. # Alpha cannot do batch searches without this file
  5. #=============================================================================
  6.  
  7. alpha::mode Brws 1.1.1 dummyBrws {} {
  8. } {} help {
  9.     During a batch search, a list of all matching lines are displayed in
  10.     a Brws window.  By using the arrow keys and the return key, you can
  11.     easily jump to the correct file and line of the match you desire.
  12.     See the "Browser-Example" for a demonstration -- click on any
  13.     fileset which appears in the dialog to see a Browser window.
  14.  
  15.     This mode is not intended for text editing.
  16. }
  17.  
  18.  
  19. namespace eval browse {}
  20.  
  21. Bind '\r'    browse::Goto  Brws
  22. Bind enter    browse::Goto  Brws
  23. ascii 0x3      browse::Goto  Brws
  24. Bind down     browse::Down Brws
  25. Bind up     browse::Up   Brws
  26. Bind 'n' <z>    browse::Down Brws
  27. Bind 'p' <z>    browse::Up   Brws
  28. ascii 0x20    browse::Down Brws
  29. ascii 0x8    browse::Up   Brws
  30. # this was below.  do we need it?
  31. Bind 'c' <Cz>    browse::Goto
  32.  
  33. proc dummyBrws {} {}
  34.  
  35. # Set this to 1 to test dynamic code
  36. if {${alpha::platform} == "alpha"} {
  37.     set browse::enableDynamic 0
  38. } else {
  39.     set browse::enableDynamic 1
  40. }
  41.  
  42. proc browse::Up {} {
  43.     set limit [nextLineStart [nextLineStart [minPos]]]
  44.     if {[pos::compare [getPos] > $limit]} {
  45.     set limit [pos::math [getPos] - 1]
  46.     }
  47.     select [lineStart $limit] [nextLineStart $limit]
  48. }
  49.  
  50. proc browse::Down {} {
  51.     set pos [getPos]
  52.     if {[pos::compare $pos < [nextLineStart [minPos]]]} {
  53.     set pos [nextLineStart [minPos]]
  54.     }
  55.     if {[pos::compare [nextLineStart $pos] < [maxPos]]} {
  56.     select [nextLineStart $pos] [nextLineStart [nextLineStart $pos]]
  57.     }
  58. }
  59.  
  60. proc nextPrevMatch {{dir 1} {wname "*Batch Find*"}} {
  61.     set wins [winNames]
  62.     set res [lsearch $wins $wname]
  63.     if {$res < 0} {
  64.     set res [lsearch -regexp $wins {\*.*\*}]
  65.     if {$res < 0} return
  66.     }
  67.     set win [lindex $wins $res]
  68.     bringToFront $win
  69.     if {$dir} {
  70.     browse::Down
  71.     } else {
  72.     browse::Up
  73.     }
  74.     browse::Goto
  75.     dispErr $win
  76. }
  77.  
  78. proc nextMatch {{wname "*Batch Find*"}} {
  79.     nextPrevMatch 1 $wname
  80. }
  81.  
  82. proc prevMatch {{wname "*Batch Find*"}} {
  83.     nextPrevMatch 0 $wname
  84. }
  85.  
  86. proc dispErr {{win "* Compiler Errors *"}} {
  87.     if {[string length $win]} {
  88.     set text [getText -w $win [getPos -w $win] [selEnd -w $win]]
  89.     if {[regexp {(Line.*)∞} $text dummy sub]} {
  90.         message "$sub"
  91.     }
  92.     }
  93. }
  94.         
  95.  
  96. ##############################################################################
  97. #  To be used in the windows created by "matchingLines" or by batch searches.
  98. #
  99. #  With the cursor positioned in a line corrsponding to a match, 
  100. #  go back and select the line in the original file that 
  101. #  generated this match.  (Like emacs 'Occur' functionality)
  102. #
  103. proc browse::Goto {} {
  104.     global browse::GotoProc
  105.     foreach pat [array names browse::GotoProc] {
  106.     if {[string match $pat [win::CurrentTail]]} {
  107.         [set browse::GotoProc($pat)]
  108.         return
  109.     }
  110.     }
  111.     global tileHeight tileWidth tileTop tileLeft tileHeight \
  112.       errorHeight errorDisp tileMargin
  113.     set loc [getPos]
  114.     set ind1 -1
  115.     while {$ind1 < 0} {
  116.     set text [getText [lineStart $loc] [nextLineStart $loc]]
  117.     set ind1 [string first "∞" $text]
  118.     set loc [nextLineStart $loc]
  119.     if {[pos::compare $loc == [maxPos]]} {break}
  120.     }
  121.     set ind2 [string last "∞" $text]
  122.     if {$ind1 == $ind2} {
  123.     set fname [string trim [string range $text $ind1 end] "∞\r\n"]
  124.     set msg ""
  125.     } else {
  126.     set tmp [string trim [string range $text 0 $ind2] "∞\r\n"]
  127.     if {[string last "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞" $tmp] < 0} {
  128.         set fname [string trim [string range $text $ind2 end] "∞\r\n"]
  129.         set msg ""
  130.     } else {
  131.         set ind1 [string last "∞" $tmp]
  132.         set fname [string trim [string range $text $ind1 $ind2] "∞\r\n"]
  133.         set msg [string trim [string range $text $ind2 end] "∞\r\n"]
  134.     }
  135.     }
  136.     set loc [getPos]
  137.     set line -1
  138.     while {1} {
  139.     if {[regexp {Line ([0-9]+):} $text "" line]} {break}
  140.     set text [getText [lineStart $loc] [nextLineStart $loc]]
  141.     set loc [pos::math [lineStart $loc] - 1]
  142.     if {[pos::compare $loc <= [minPos]]} {
  143.         # It's a browse window without line numbers, since we've
  144.         # backed up to the top of the window.
  145.         set line -1
  146.         break
  147.     }
  148.     }
  149.     
  150.     set top $tileTop
  151.     set geo [getGeometry]
  152.     if {([lindex $geo 0] != $tileLeft) || ([lindex $geo 1] != $top) \
  153.       || ([lindex $geo 3] != $errorHeight) } {
  154.     moveWin $tileLeft $top
  155.     sizeWin $tileWidth $errorHeight
  156.     }
  157.     set mar $tileMargin
  158.     incr top [expr {$errorHeight + $mar}]
  159.     if {[browse::OpenWindow $fname]} {
  160.     edit -c -w -g $tileLeft $top $tileWidth $errorDisp $fname
  161.     set geo [getGeometry]
  162.     if {([lindex $geo 0] != $tileLeft) || ([lindex $geo 1] != $top) \
  163.       || ([lindex $geo 2] != $tileWidth) || ([lindex $geo 3] != $errorDisp) } {
  164.         sizeWin $tileWidth $errorDisp
  165.         moveWin $tileLeft $top
  166.     }
  167.     } else {
  168.     if {![string match "*Link*" \
  169.       [getText [minPos] [nextLineStart [minPos]]]]} {
  170.         alertnote "File \"$fname\" not found." 
  171.     }
  172.     return
  173.     }
  174.     if {$line >= 0} {
  175.     set pos [rowColToPos $line 0]
  176.     select $pos [nextLineStart $pos]
  177.     }
  178.     message $msg
  179. }
  180.  
  181. proc browse::OpenWindow {fname} {
  182.     global tileHeight tileWidth tileTop tileLeft tileHeight \
  183.       errorHeight errorDisp tileMargin
  184.     if {[file exists $fname]} {
  185.     set top $tileTop
  186.     set mar $tileMargin
  187.     incr top [expr {$errorHeight + $mar}]
  188.     edit -c -w -g $tileLeft $top $tileWidth $errorDisp $fname
  189.     set geo [getGeometry]
  190.     if {([lindex $geo 0] != $tileLeft) || ([lindex $geo 1] != $top) \
  191.       || ([lindex $geo 2] != $tileWidth) || ([lindex $geo 3] != $errorDisp) } {
  192.         sizeWin $tileWidth $errorDisp
  193.         moveWin $tileLeft $top
  194.     }
  195.     return 1
  196.     } else {
  197.     return 0
  198.     }
  199. }
  200.  
  201. set browse::lastMatchingLines ""
  202.  
  203. proc matchingLines {{reg ""} {for 1} {ign 1} {word 0} {regexp 1}} {
  204.     global browse::lastMatchingLines
  205.     
  206.     if {![string length $reg] && \
  207.       [catch {prompt "Regular expression:" [set browse::lastMatchingLines]} reg]} return
  208.     set browse::lastMatchingLines $reg
  209.     if {![string length $reg]} return
  210.     if {!$regexp} {
  211.     set reg [quote::Regfind $reg]
  212.     }
  213.     if {$word} {
  214.     set reg "^.*\\b$reg\\b.*$"
  215.     } else {
  216.     set reg "^.*$reg.*$"
  217.     }
  218.     set pos [expr {$for ? [minPos] : [getPos]}]
  219.     set fileName [win::StripCount [win::Current]]
  220.     set matches 0
  221.     browse::Start {* Matching Lines *} \
  222.       "%d matching lines (<cr> to go to match)\r-----" 
  223.     while {![catch {search -s -f 1 -r 1 -i $ign -- $reg $pos} mtch]} {
  224.     browse::Add $fileName [eval getText $mtch] \
  225.       [lindex [posToRowCol [lindex $mtch 0]] 0] 0
  226.     set pos [lindex $mtch 1]
  227.     incr matches
  228.     }
  229.     browse::Complete
  230. }
  231.  
  232. ## 
  233.  # -------------------------------------------------------------------------
  234.  # 
  235.  # "grepsToWindow" --
  236.  # 
  237.  #  'args' is a list of items
  238.  # -------------------------------------------------------------------------
  239.  ##
  240. proc grepsToWindow {title args} {
  241.     global tileLeft tileTop tileWidth tileHeight errorHeight
  242.     win::SetProportions
  243.     new -n $title -g $tileLeft $tileTop $tileWidth $errorHeight -m Brws \
  244.       -tabsize 8 -info [join $args ""]
  245.     select [nextLineStart [nextLineStart [minPos]]] [nextLineStart [nextLineStart [nextLineStart [minPos]]]]
  246.     message ""
  247. }
  248.  
  249. ## 
  250.  # -------------------------------------------------------------------------
  251.  # 
  252.  # "browse::Format" --
  253.  # 
  254.  #  Can be used by external code to ensure browse information is in an
  255.  #  acceptable format, and to simplify external code.
  256.  # -------------------------------------------------------------------------
  257.  ##
  258. proc browse::Format {file match line {withname 1}} {
  259.     if {$withname} {
  260.     set l [expr {40 - [string length [file tail $file]]}]
  261.     append res "\"[file tail $file]\"; " [format "%$l\s" ""] " "
  262.     } else {
  263.     regsub -all "\t" $match "  " match
  264.     }
  265.     append res [format "Line %d:\r" $line] $match \
  266.       "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$file"
  267.     return $res
  268. }
  269.  
  270. proc browse::RedoCount {} {
  271.     global browse::prefix browse::count
  272.     replaceText [minPos] [pos::math [minPos] + [string length [format [set browse::prefix] 1]]] \
  273.       [format [set browse::prefix] [set browse::count]]
  274. }
  275.  
  276. proc browse::Complete {} {
  277.     global browse::lines browse::none browse::haveWindow browse::count
  278.     if {[string length [set browse::haveWindow]]} {
  279.     bringToFront [set browse::haveWindow]
  280.     browse::RedoCount
  281.     goto [minPos]
  282.     select [nextLineStart [nextLineStart [minPos]]] [nextLineStart [nextLineStart [nextLineStart [minPos]]]]
  283.     setWinInfo read-only 1
  284.     return 0
  285.     } else {
  286.     if {[set browse::count]} {
  287.         browse::createWindow
  288.         setWinInfo read-only 1
  289.         select [nextLineStart [nextLineStart [minPos]]] [nextLineStart [nextLineStart [nextLineStart [minPos]]]]
  290.         return 0
  291.     } else {
  292.         beep
  293.         message [set browse::none]
  294.         return 1
  295.     }
  296.     }
  297. }
  298.  
  299. proc browse::createWindow {} {
  300.     global tileLeft tileTop tileWidth tileHeight errorHeight \
  301.       browse::lines browse::title browse::prefix browse::haveWindow \
  302.       browse::backGround browse::count
  303.     if {[set browse::backGround]} {set w [win::Current]}
  304.     win::SetProportions
  305.     set browse::haveWindow [new -n [set browse::title] \
  306.       -g $tileLeft $tileTop $tileWidth $errorHeight -m Brws \
  307.       -tabsize 8 -shell 1 \
  308.       -text "[format [set browse::prefix] [set browse::count]]\r[join [set browse::lines] \r]\r"]
  309.     set browse::lines {}
  310.     if {[set browse::backGround]} {bringToFront $w}
  311.     message ""
  312. }
  313.  
  314. proc browse::updateWindow {} {
  315.     global browse::haveWindow browse::lines
  316.     placeText -w [set browse::haveWindow] [maxPos -w [set browse::haveWindow]] "[join [set browse::lines] \r]\r"
  317.     set browse::lines {}
  318. }
  319.  
  320. ## 
  321.  # -------------------------------------------------------------------------
  322.  # 
  323.  # "browse::Add" --
  324.  # 
  325.  #  Add the information to our list of browse items.  We can actually 
  326.  #  add these dynamically to the window if we like.
  327.  # -------------------------------------------------------------------------
  328.  ##
  329. proc browse::Add {file match line {withname 1}} {
  330.     global browse::lines browse::dynamic browse::haveWindow browse::count
  331.     lappend browse::lines [browse::Format $file $match $line $withname]
  332.     incr browse::count
  333.     if {[set browse::dynamic]} {
  334.     if {[string length [set browse::haveWindow]]} {
  335.         browse::updateWindow
  336.     } else {
  337.         browse::createWindow
  338.     }
  339.     global alpha::platform
  340.     if {${alpha::platform} != "alpha"} {update}
  341.     }
  342. }
  343.  
  344. ## 
  345.  # -------------------------------------------------------------------------
  346.  # 
  347.  # "browse::Dynamic" --
  348.  # 
  349.  #  Somewhat experimental.
  350.  # -------------------------------------------------------------------------
  351.  ##
  352. proc browse::Dynamic {{backgd 0} {dyn 1}} {
  353.     global browse::dynamic browse::haveWindow browse::backGround browse::enableDynamic
  354.     if {![set browse::enableDynamic]} {return}
  355.     set browse::dynamic $dyn
  356.     set browse::haveWindow ""
  357.     set browse::backGround $backgd
  358. }
  359.  
  360. proc browse::Start {{theTitle {* Matching Lines *}} \
  361.   {thePrefix "%d matching lines (<cr> to go to match)\r-----"} \
  362.   {ifNone "No matches found."}} {
  363.     global browse::lines browse::title browse::prefix browse::none \
  364.       browse::dynamic browse::haveWindow browse::backGround browse::count
  365.     set browse::lines {}
  366.     set browse::title $theTitle
  367.     set browse::prefix $thePrefix
  368.     set browse::none $ifNone
  369.     set browse::dynamic 0
  370.     set browse::haveWindow ""
  371.     set browse::backGround 0
  372.     set browse::count 0
  373. }
  374.  
  375.